home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol030 / forth.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  5.1 KB  |  244 lines
  1. 10 REM **********BASIC FORTH V. 3 ************
  2. 11 ' by C. H. Ting
  3. 12 ' PO BOX 504, Sunnyvale, CA 94086
  4. 13 ' converted to IBM PC by Art Bevilacqua, 14 Arthur St. Danvers, Ma 01923
  5. 14 ' See Dr. Dobbs Journal Number 60, October 1981 for the base article
  6. 20 DIM S(40),R(20),L(10),LO(10)
  7. 30 DIM I$(80)
  8. 40 PRINT "BASIC FORTH VERSION V.3"
  9. 50 REM N IS SP, M IS RP, K IS IP, AND L IS W.
  10. 60 ON ERROR GOTO 90
  11. 70 ON KEY(1) GOSUB 2340
  12. 80 GOTO 100
  13. 90 PRINT A$," ?"
  14. 100 M=0
  15. 110 N=0
  16. 120 REM ************ TEXT INTERPRETER  ************
  17. 130 K=1
  18. 140 INPUT I$
  19. 150 L1=0
  20. 160 L(K)=L1
  21. 170 LO(K)=LEN(I$)
  22. 180 L1=LO(K)
  23. 190 IF N<0 THEN GOTO 210
  24. 200 GOTO 230
  25. 210 PRINT "STACK EMPTY"
  26. 220 GOTO 100
  27. 230 L(K)=L(K)+1
  28. 240 IF L(K)>LO(K) THEN GOTO 350
  29. 250 B$=MID$(I$,L(K),1)
  30. 260 IF B$=" " THEN GOTO 230
  31. 270 A$=B$
  32. 280 L(K)=L(K)+1
  33. 290 IF L(K)>LO(K) THEN GOTO 340
  34. 300 B$=MID$(I$,L(K),1)
  35. 310 IF B$=" " THEN GOTO 340
  36. 320 A$=A$+B$
  37. 330 GOTO 280
  38. 340 GOTO 400
  39. 350 IF K<2 THEN GOTO 130
  40. 360 K=K-1
  41. 370 I$=MID$(I$,1,LO(K))
  42. 380 L1=LO(K)
  43. 390 GOTO 230
  44. 400 REM ***********  DICTIONARY **********
  45. 410 REM 300-900 :: HIGH LEVEL DEFINITIONS
  46. 420 IF A$<>"SQUARE" THEN GOTO 470
  47. 430 B$="DUP *"
  48. 440 I$=I$+B$
  49. 450 K=K+1
  50. 460 GOTO 160
  51. 470 IF A$<>"CUBE" THEN GOTO 520
  52. 480 B$="DUP SQUARE *"
  53. 490 I$=I$+B$
  54. 500 K=K+1
  55. 510 GOTO 160
  56. 520 IF A$<>"TEST" THEN GOTO 570
  57. 530 B$="DO PI 10 / R@ * SIN . LOOP"
  58. 540 I$=I$+B$
  59. 550 K=K+1
  60. 560 GOTO 160
  61. 570 REM
  62. 580 REM *************** LOW LEVEL DEFINITIONS NUCLEUS **********
  63. 590 IF A$<>"+" THEN GOTO 630
  64. 600 N=N-1
  65. 610 S(N)=S(N)+S(N+1)
  66. 620 GOTO 190
  67. 630 IF A$<>"-" THEN GOTO 670
  68. 640 N=N-1
  69. 650 S(N)=S(N)-S(N+1)
  70. 660 GOTO 190
  71. 670 IF A$<>"*" THEN GOTO 710
  72. 680 N=N-1
  73. 690 S(N)=S(N)*S(N+1)
  74. 700 GOTO 190
  75. 710 IF A$<>"/" THEN GOTO 750
  76. 720 N=N-1
  77. 730 S(N)=S(N)/S(N+1)
  78. 740 GOTO 190
  79. 750 IF A$<>"ABS" THEN GOTO 780
  80. 760 S(N)=ABS(S(N))
  81. 770 GOTO 190
  82. 780 IF A$<>"ATN" THEN GOTO 810
  83. 790 S(N)=ATN(S(N))
  84. 800 GOTO 190
  85. 810 IF A$<>"COS" THEN GOTO 840
  86. 820 S(N)=COS(S(N))
  87. 830 GOTO 190
  88. 840 IF A$<>"EXP" THEN GOTO 870
  89. 850 S(N)=EXP(S(N))
  90. 860 GOTO 190
  91. 870 IF A$<>"INT" THEN GOTO 900
  92. 880 S(N)=INT(S(N))
  93. 890 GOTO 190
  94. 900 IF A$<>"LOG" THEN GOTO 930
  95. 910 LET S(N)=LOG(S(N))
  96. 920 GOTO 190
  97. 930 IF A$<>"RND" THEN GOTO 960
  98. 940 S(N)=RND(-N)
  99. 950 GOTO 190
  100. 960 IF A$<>"SGN" THEN GOTO 990
  101. 970 S(N)=SGN(S(N))
  102. 980 GOTO 190
  103. 990 IF A$<>"SIN" THEN GOTO 1020
  104. 1000 S(N)=SIN(S(N))
  105. 1010 GOTO 190
  106. 1020 IF A$<>"SQR" THEN GOTO 1050
  107. 1030 S(N)=SQR(S(N))
  108. 1040 GOTO 190
  109. 1050 IF A$<>"TAN" THEN GOTO 1080
  110. 1060 S(N)=TAN(S(N))
  111. 1070 GOTO 190
  112. 1080 IF A$<>"^" THEN GOTO 1120
  113. 1090 N=N-1
  114. 1100 S(N)=S(N)^S(N+1)
  115. 1110 GOTO 190
  116. 1120 IF A$<>"S?" THEN GOTO 1170
  117. 1130 FOR I=1 TO N
  118. 1140 PRINT S(N-I+1)
  119. 1150 NEXT I
  120. 1160 GOTO 190
  121. 1170 IF A$<>"." THEN GOTO 1220
  122. 1180 IF N<1 THEN GOTO 210
  123. 1190 PRINT S(N)
  124. 1200 N=N-1
  125. 1210 GOTO 190
  126. 1220 IF A$<>"DUP" THEN GOTO 1260
  127. 1230 N=N+1
  128. 1240 S(N)=S(N-1)
  129. 1250 GOTO 190
  130. 1260 IF A$<>"DROP" THEN GOTO 1290
  131. 1270 N=N-1
  132. 1280 GOTO 190
  133. 1290 IF A$<>"SWAP" THEN GOTO 1340
  134. 1300 S(N+1)=S(N-1)
  135. 1310 S(N-1)=S(N)
  136. 1320 S(N)=S(N+1)
  137. 1330 GOTO 190
  138. 1340 IF A$<>"OVER" THEN GOTO 1380
  139. 1350 N=N+1
  140. 1360 S(N)=S(N-2)
  141. 1370 GOTO 190
  142. 1380 IF A$<>">R" THEN GOTO 1430
  143. 1390 M=M+1
  144. 1400 R(M)=S(N)
  145. 1410 N=N-1
  146. 1420 GOTO 190
  147. 1430 IF A$<>"R>" THEN GOTO 1480
  148. 1440 N=N+1
  149. 1450 S(N)=R(M)
  150. 1460 M=M-1
  151. 1470 GOTO 190
  152. 1480 IF A$<>"R@" THEN GOTO 1520
  153. 1490 N=N+1
  154. 1500 S(N)=R(M)
  155. 1510 GOTO 190
  156. 1520 REM **************CONTROL STRUCTURES **************
  157. 1530 IF A$<>"=" THEN GOTO 1600
  158. 1540 N=N-1
  159. 1550 IF S(N)=S(N+1) THEN GOTO 1580
  160. 1560 S(N)=0
  161. 1570 GOTO 190
  162. 1580 S(N)=1
  163. 1590 GOTO 190
  164. 1600 IF A$<>">" THEN GOTO 1670
  165. 1610 N=N-1
  166. 1620 IF S(N)>S(N+1) THEN GOTO 1650
  167. 1630 S(N)=0
  168. 1640 GOTO 190
  169. 1650 S(N)=1
  170. 1660 GOTO 190
  171. 1670 IF A$<>"<" THEN GOTO 1740
  172. 1680 N=N-1
  173. 1690 IF S(N)<S(N+1) THEN GOTO 1720
  174. 1700 S(N)=0
  175. 1710 GOTO 190
  176. 1720 S(N)=1
  177. 1730 GOTO 190
  178. 1740 IF A$<>"IF" THEN GOTO 1870
  179. 1750 N=N-1
  180. 1760 IF S(N+1) THEN GOTO 190
  181. 1770 FOR I=L(K) TO LO(K)-3
  182. 1780 B$=MID$(I$,I,4)
  183. 1790 IF B$="ELSE" THEN GOTO 1840
  184. 1800 IF B$="THEN" THEN GOTO 1840
  185. 1810 NEXT I
  186. 1820 PRINT "IF?"
  187. 1830 GOTO 100
  188. 1840 L(K)=I+4
  189. 1850 GOTO 190
  190. 1860 GOTO 190
  191. 1870 IF A$<>"ELSE" THEN GOTO 1890
  192. 1880 GOTO 1770
  193. 1890 IF A$<>"THEN" THEN GOTO 1910
  194. 1900 GOTO 190
  195. 1910 IF A$<>"BEGIN" THEN GOTO 1950
  196. 1920 M=M+1
  197. 1930 R(M)=L(K)
  198. 1940 GOTO 190
  199. 1950 IF A$<>"UNTIL" THEN GOTO 2030
  200. 1960 N=N-1
  201. 1970 IF S(N+1) THEN GOTO 2010
  202. 1980 IF S(N+1) THEN GOTO 190
  203. 1990 L(K)=R(M)
  204. 2000 GOTO 190
  205. 2010 M=M-1
  206. 2020 GOTO 190
  207. 2030 IF A$<>"DO" THEN GOTO 2120
  208. 2040 M=M+1
  209. 2050 R(M)=L(K)
  210. 2060 M=M+1
  211. 2070 R(M)=S(N-1)
  212. 2080 M=M+1
  213. 2090 R(M)=S(N)
  214. 2100 N=N-2
  215. 2110 GOTO 190
  216. 2120 IF A$<>"LOOP" THEN GOTO 2190
  217. 2130 R(M)=R(M)+1
  218. 2140 IF R(M-1)>R(M) THEN GOTO 2170
  219. 2150 M=M-3
  220. 2160 GOTO 190
  221. 2170 L(K)=R(M-2)
  222. 2180 GOTO 190
  223. 2190 REM ********* CONSTANTS **************
  224. 2200 IF A$<>"PI" THEN GOTO 2240
  225. 2210 N=N+1
  226. 2220 S(N)=3.14159
  227. 2230 GOTO 190
  228. 2240 IF A$<>"0" THEN GOTO 2280
  229. 2250 N=N+1
  230. 2260 S(N)=0
  231. 2270 GOTO 190
  232. 2280 IF A$<>"STOP" THEN GOTO 2300
  233. 2290 STOP
  234. 2300 REM ********* NUMBER **********
  235. 2310 N=N+1
  236. 2320 S(N)=VAL(A$)
  237. 2330 GOTO 190
  238. 2340 END
  239. STOP" THEN GOTO 2300
  240. 2290 STOP
  241. 2300 REM ********* NUMBER **********
  242. 2310 N=N+1
  243. 2320 S(N)=VAL(A$)
  244. 2330 GO